home *** CD-ROM | disk | FTP | other *** search
/ PCMania 64 / PCMania CD64_1.iso / phy / phy005 / lowlevel / trian.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-07-04  |  1.9 KB  |  97 lines

  1. PROGRAM ProbaTriangle;   { Dibujado de triangulos rellenos. Navi/PhyMosys }
  2.  
  3. USES Crt;
  4.  
  5. VAR i : Integer;
  6.  
  7. PROCEDURE Modo(x : WORD); Assembler;
  8. ASM
  9.   mov ax, x
  10.   int 10h
  11. END;
  12.  
  13. PROCEDURE Linea(X, Y, tamany : Integer; color : BYTE; dreta : Boolean);
  14. VAR
  15.   i : Integer;
  16. BEGIN
  17.   If dreta Then
  18.     For i:=0 to tamany do
  19.       Mem[$A000:(Y*320+X+i)]:=color
  20.    Else
  21.     For i:=0 to tamany do
  22.       Mem[$A000:(Y*320+X-i)]:=color;
  23. END;
  24.  
  25. PROCEDURE Triangle(x1,y1, x2,y2, x3,y3 : Integer; col : BYTE);
  26.   PROCEDURE Canviar(VAR a, b : Integer);
  27.   VAR Aux : Integer;
  28.   BEGIN
  29.     Aux:=b;
  30.     b:=a;
  31.     a:=Aux;
  32.   END;
  33. VAR
  34.   Cy1,
  35.   Cx1, Cx2 : Real;
  36.   m1, m2   : Real;
  37.   com      : Boolean;
  38. BEGIN
  39.   If NOT (y1<y2) Then
  40.    BEGIN
  41.      Canviar(x1,x2);
  42.      Canviar(y1,y2);
  43.    END;
  44.   If NOT (y1<y3) Then
  45.    BEGIN
  46.      Canviar(x1,x3);
  47.      Canviar(y1,y3);
  48.    END;
  49.   If NOT (y2<y3) Then
  50.    BEGIN
  51.      Canviar(x2,x3);
  52.      Canviar(y2,y3);
  53.    END;                 { Ordenados! }
  54.   Cx1:=x1; Cy1:=y1;
  55.   Cx2:=x1;
  56.   m1:=(x1-x3)/(y1-y3);
  57.   m2:=(x2-x1)/(y2-y1);
  58.   If x2>x1 Then
  59.     com:=TRUE
  60.    Else
  61.     com:=FALSE;
  62.   While Cy1<y2 do
  63.    BEGIN
  64.      Linea(Integer(Round(Cx1)), Integer(Round(Cy1)),
  65.            Integer(Abs(Round(Cx2-Cx1))), col, com);
  66.      Cx1:=Cx1+m1;
  67.      Cx2:=Cx2+m2;
  68.      Cy1:=Cy1+1;
  69.    END;
  70.   m2:=(x2-x3)/(y2-y3);
  71.   While Cy1<=y3 do
  72.    BEGIN
  73.      Linea(Integer(Round(Cx1)), Integer(Round(Cy1)),
  74.            Integer(Abs(Round(Cx2-Cx1))), col, com);
  75.      Cx1:=Cx1+m1;
  76.      Cx2:=Cx2+m2;
  77.      Cy1:=Cy1+1;
  78.    END;
  79. END;
  80.  
  81. BEGIN
  82.   WriteLn('Demo de dibujado de triangulos');
  83.   ReadLn;
  84.   Modo($13);
  85.  
  86.   For i:=1 to 200 do
  87.    BEGIN
  88.      Triangle(130,80, 100,20, 40,130, i);
  89.      Triangle(20,60, 20,30, 100,40, i);
  90.      Triangle(310,0, 170,110, 190,15, i);
  91.      Triangle(134,150, 95,135, 120,115, i);
  92.    END;
  93.  
  94.   ReadLn;
  95.   Modo(3);
  96. END.
  97.